home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / snobol / vsnobol / bitzer.sno next >
Text File  |  1991-02-14  |  7KB  |  255 lines
  1. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. *
  3. *    PGM: BITZER.SNO
  4. *    Version 2.0
  5. *
  6. *    Created by:  Eric Johnson, Dean, College of Liberal Arts,
  7. *             Dakota State University, Madison, SD.
  8. *    Date:        May - June, 1987
  9. *
  10. *    Version 2.1
  11. *    Modifed by Catspaw, Inc. for improved efficiency.
  12. *    SORT function added for Vanilla SNOBOL4
  13. *
  14. *    Version 2.2, December 11, 1989
  15. *    Corrected bug in PRINT function.
  16. *
  17. *    Description:  BITZER creates an alphabetical index for files,
  18. *        giving each page number a word is found on.
  19. *        It first reads the file identified as INWORDS; this provides
  20. *        a list of keywords NOT to be indexed.
  21. *        The file identified as INFILE is indexed.
  22. *        In this file, the start of each page must be
  23. *        indicated thus:
  24. *
  25. *        A special character (@ # or *) should be in column 1,
  26. *        then "PAGE", one space, and the page designation.
  27. *        This can readily be altered by rewriting the pattern PAGE.DES.
  28. *
  29. *        The output, the index, in found in the file
  30. *        identified as OUTFILE.
  31. *
  32. *        BITZER adjusts output lines in which the listing of
  33. *        of page numbers is > 57 columns, and it removes the last
  34. *        comma.
  35. *
  36. *        The operation of this program is described in detail in 
  37. *        "A Computer Program for Word Processing," published in 
  38. *        RESEARCH IN WORD PROCESSING NEWSLETTER, Fall, 1987. 
  39. *
  40. *
  41. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  42.  
  43. *    Part 1: Initialization
  44. *
  45.         &ANCHOR = 0
  46.         &TRIM = 1
  47.  
  48. *    Define Constants and patterns
  49. *
  50.         NUMBERS = "0123456789"
  51.         LTRS = &UCASE  NUMBERS  "'-><"
  52.         SP = DUPL(" ",20)
  53.  
  54. *    Define Patterns
  55.         PAGE.DES = POS(0) ANY("@*#") "PAGE" SPAN(" ")
  56. +               SPAN(NUMBERS) . PGNO
  57.  
  58.         WPAT = POS(0) BREAK(LTRS) SPAN(LTRS) . WORD
  59.         WCHK = POS(0) BREAK(&UCASE)
  60.  
  61.         INDEX = TABLE(100,100)
  62.  
  63. *    Part 2: Function Definitions
  64. *
  65. *    Function to scroll a given number of lines.
  66. *
  67.     DEFINE('SCROLL(MAX)N')                :(SCROLL_END)
  68. SCROLL        SCREEN = LT(N,MAX)            :F(RETURN)
  69.         N = N + 1                :(SCROLL)
  70. SCROLL_END
  71.  
  72.  
  73. *    PRINT(COL1,COL2,L,BC)
  74. *
  75. *    Function to print a string COL2 in a column no longer than L
  76. *    characters, breaking words between the character in BC.
  77. *    COL1 is the first column of data.
  78. *
  79.     DEFINE('PRINT(COL1,COL2,L,BC)C,LINE')
  80.         PRINT_PAT = RTAB(1) . LINE LEN(1) . C    :(PRINT_END)
  81.  
  82. *    Function entry point
  83. PRINT        OUTPUT = LE(SIZE(COL2),L) COL1 COL2    :S(RETURN)
  84. *    Remove first L characters to LINE.
  85.         COL2 LEN(L) . LINE =
  86.  
  87. *    Isolate last character on line to C.
  88. PRINT_2        LINE PRINT_PAT                :F(RETURN)
  89.  
  90. *    If C is not BC, prepend it to S and get another char from LINE.
  91.         COL2 = DIFFER(C,BC) C COL2        :S(PRINT_2)
  92.  
  93. *    If C is BC, this is a good break point.
  94.         OUTPUT = COL1 LINE BC
  95.  
  96. *    Replace COL1 with blanks so future lines will pad properly
  97.         COL1 = DUPL(' ',SIZE(COL1))        :(PRINT)
  98. PRINT_END
  99.  
  100.  
  101. *    This function sorts the members of a table using a Shell sort method.
  102. *    The general idea is to try to move out-of-order elements large
  103. *    distances quickly.  A straight-line insertion sort is performed on
  104. *    a series of sub-lists of the master list.  See Comm. of the ACM,
  105. *    July, 1959 for Shell's original article, or Knuth, The Art of
  106. *    Computer Programming, Vol. 3.
  107. *
  108. *    A table is converted to a two column array, with the first column
  109. *    containing the table keys, and the second column containing the
  110. *    entry values.
  111. *
  112. *    Sorting is not particularly efficient in SNOBOL4.  For that reason,
  113. *    SNOBOL4+ contains a built-in assembly-language SORT function, which
  114. *    should be used for production work.
  115. *
  116. *    The second argument to the function is either a 1 or 2, to specify
  117. *    sorting on the keys or the entry values, respectively.  It defaults
  118. *    to 1 if omitted.
  119. *
  120. *    The third argument is a string specifying the comparison function
  121. *    to be applied to table elements.  It defaults to 'LGT', the lexical
  122. *    compare function, which is suitable for strings.  'GT' could be used
  123. *    if the entries are numeric.
  124. *
  125. *    The result returned is the array created from the argument table.
  126. *    The function fails if the table could not be converted to an array.
  127. *
  128. *    From STRING AND LIST PROCESSING IN SNOBOL4 by Ralph E. Griswold,
  129. *             by permission of the author.
  130. *    ----------------------------------------------------------------
  131. *
  132.     DEFINE("SORT(TABLE,C,P)I,N,M,J,G,K,T1,T2")
  133.         ALEN    =    BREAK(",") . N        :(SORT_END)
  134.  
  135. SORT        SORT    =    CONVERT(TABLE,"ARRAY")    :F(FRETURN)
  136.         C    =    IDENT(C) 1
  137.         P    =    IDENT(P) "LGT"
  138.         OPSYN("CMP",P)
  139.         PROTOTYPE(SORT)    ALEN
  140.         G    =    N
  141.  
  142. SORTG        G    =    GT(G,1) G / 2        :F(RETURN)
  143.         M    =    N - G
  144. SORTK        K    =    0
  145.         I    =    1
  146. SORTJ        J    =    I + G
  147.         CMP(SORT[I,C],SORT[J,C])        :F(SORTI)
  148.         T1    =    SORT[I,1]
  149.         T2    =    SORT[I,2]
  150.         SORT[I,1]    =    SORT[J,1]
  151.         SORT[I,2]    =    SORT[J,2]
  152.         SORT[J,1]    =    T1
  153.         SORT[J,2]    =    T2
  154.         K    =    K + 1
  155. SORTI        I    =    LT(I,M) I + 1        :S(SORTJ)
  156.         GT(K,0)                    :S(SORTK)F(SORTG)
  157. SORT_END
  158.  
  159. *
  160. *    Part 3: Open files.
  161. *
  162. START        SCREEN = "Enter file to be indexed: " CHAR(26)
  163.         INFILE = INPUT                :F(END)
  164.         INPUT(.IDX_FILE,1,,INFILE)        :F(START)
  165.  
  166. START_1        SCREEN = "Enter file of words to exclude from index,"
  167.         SCREEN = "or ENTER if no exclusion file: " CHAR(26)
  168.         INWORDS = INPUT                :F(END)
  169.         IDENT(INWORDS)                :S(START_2)
  170.         INPUT(.IN,2,,INWORDS)            :F(START_1)
  171.  
  172. START_2        SCREEN = "Enter output file name: " CHAR(26)
  173.         OUTFILE = INPUT                :F(END)
  174.         OUTPUT(.OUTPUT,3,,OUTFILE)        :F(START_2)
  175.         
  176.  
  177. *
  178. *    Part 4: Read in words not to be indexed if file provided.
  179. *
  180.         SCROLL(25)
  181.         SCREEN = SP "Bitzer is indexing the text."
  182.         SCREEN =
  183.         SCREEN = SP "Please do not interrupt."
  184.         SCROLL(10)
  185.  
  186. *    Record in INDEX table with "#" as special marker.
  187. *
  188.         IDENT(INWORDS)                :S(READ)
  189. GETWDS        WORDS = REPLACE(IN,&LCASE,&UCASE)    :F(READ)
  190. GETW         WORDS    WPAT  =            :F(GETWDS)
  191.         INDEX<WORD> = "#"            :(GETW)
  192. *
  193. *    Part 5:  Main Processing
  194. *
  195. READ        LINE = REPLACE(IDX_FILE,&LCASE,&UCASE)    :F(DO_SORT)
  196.  
  197. *    Check for page number
  198.         LINE PAGE.DES                :F(NEXTW)
  199.         TESTP = " " PGNO ","            :(READ)
  200.  
  201. *    Isolate word, see if want to keep it.
  202. NEXTW        LINE WPAT =                :F(READ)
  203.  
  204. *    Should be at least one letter somewhere in the word, else ignore.
  205.         WORD  WCHK                :F(NEXTW)
  206.  
  207. *    A pointer to the table entry is used, to avoid making multiple
  208. *    lookups in the table.  See if it is marked as "ignore."
  209.         WORD_PTR = .INDEX<WORD>
  210.         IDENT($WORD_PTR,"#")            :S(NEXTW)
  211.  
  212. *    Error if word longer than 18 characters
  213.         LE(SIZE(WORD),18)            :S(TESTPG)
  214.         SCREEN = 'Word over 18 letters: "'
  215. +              WORD    '"; it is ignored.'
  216.         SCREEN =                :(NEXTW)
  217.  
  218.  
  219. *    See if already have an entry on this page for this word.
  220. TESTPG        $WORD_PTR  TESTP            :S(NEXTW)
  221.         $WORD_PTR = $WORD_PTR TESTP        :(NEXTW)
  222.  
  223. *
  224. *    Part 6: Sort results
  225. *
  226. DO_SORT        SCROLL(25)
  227.         SCREEN = SP "Bitzer is alphabetizing the index."
  228.         SCREEN =
  229.         SCREEN = SP "Please do not interrupt."
  230.         SCROLL(10)
  231.         INDEX = SORT(INDEX)            :S(SORTED)
  232.         OUTPUT = 'THERE IS NOTHING IN TABLE!'    :(END)
  233. *
  234. *    Part 7: Print results
  235. *
  236. SORTED        OUTPUT = 'WORD                PAGE NUMBERS'
  237.         OUTPUT = ' '
  238.  
  239. *    Print in columns.  Break long lines if necessary.  Remove trailing
  240. *    comma or "#" from entry.
  241. *
  242. PRINTW        S = S + 1
  243.         INDEX<S,2> RTAB(1) . C2            :F(LAST)
  244.         IDENT(C2)                :S(PRINTW)
  245.         PRINT(RPAD(INDEX<S,1>,19),C2,57,",")    :(PRINTW)
  246.  
  247. LAST        SCROLL(25)
  248.         SCREEN = SP "Bitzer is finished."
  249.         SCREEN =
  250.         SCREEN = SP "An index of " INFILE  
  251.         SCREEN = DIFFER(INWORDS) SP "excluding the words in " INWORDS
  252.         SCREEN = SP "will be found in " OUTFILE
  253.         SCROLL(9)
  254. END
  255.